home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Mac Mania 2
/
MacMania 2.toast
/
Demo's
/
Tools&Utilities
/
Programming
/
MacStarter Pascal 1.0
/
xWindows definition files
/
xWindow.p
< prev
Encoding:
Amiga
Atari
Commodore
DOS
FM Towns/JPY
Macintosh
Macintosh JP
NeXTSTEP
RISC OS/Acorn
Shift JIS
UTF-8
Wrap
Text File
|
1993-04-21
|
47.1 KB
|
1,355 lines
|
[
TEXT/PJMM
]
unit xWindow;
{ This unit defines the object type xWindows, which encapsulates much of the }
{ standard behavior of Macintosh Windows. It is meant to be used as an abstract }
{ class. A programmer can define a descendent class that adds functionality, such }
{ as graphics, text, or additional controls, to the basic behavior. (An xWindow }
{ could also be used directly for simple applications.) }
{ Also defined in this unit is the abstract class xWindowDecoration. This }
{ represents things that can be added to windows. For example, an instance of the }
{ descendent class xButton would be a button that the user could press. Once }
{ installed in an xWindow, an xWindowDecoration can automatically receive and }
{ respond to events. (You can directly use an xWindowDecoration to make a }
{ specific cursor appear over a rectangle in the window.) }
{ This unit is meant to be used with the main program StandardMain.p, which }
{ includes an event loop that routes events to appropriate windows. If the only }
{ windows used in your application are xWindows, you will not need to make any }
{ changes to the main program, except to add support for any menus or menu items }
{ that you add. }
{ To open an use an xWindow, you should declare a variable VAR X: xWindow, }
{ allocate storage with NEW(X), then open the window with X.open or X.openInRect. }
{ As an alternative to the last step, you can set up the appearance of the window before }
{ opening it by calling X.setDefaults, then calling routines such as X.setFeatures to }
{ change the defaults, then calling X.doBasicOpen. Note that X.doBasicOpen requires the }
{ values of certain instance variables to be set before it is called. }
{ To define a subclass of xWindow, you should generally override one or both of the }
{ methods seDefaults and openInRect. SetDefaults is the place to do any setup that is }
{ required before the window is opened; it should always be called at the beginning of }
{ openInRect. OpenInRect should then call doBasicOpen to open the window; after this, }
{ it can make any modifications or additions to the window. DoBasicOpen itself should }
{ not be modified. }
{ The Macintosh ordinarily identifies windows by WindowPtr's. Each xWindow }
{ corresponds to some windowPtr. Sometimes, the Mac gives you only the windowPtr }
{ and you have to find the corresponding xWindow. A function Window2xWindow is }
{ exported for this purpose. }
{ The exported procedure InitXWindows should be called to initialize this unit; it }
{ is called in StandardMain, and need not be used elsewhrere. }
interface
type
windowFeatures = (hasGoAway, hasGrow, hasVScroll, hasHScroll, hasZoom, DAStyle);
windowFeatureSet = set of windowFeatures;
xWindow = object
{ INSTANCE VARIABLES -- you should not use these directly }
nextXWindow: xWindow; { link to next window in list of open xWindows }
theWindow: WindowPtr; { the refCon of this window contains a ref to this object }
userRef: longint; { not used by xWindows system; available for any use }
features: windowFeatureSet; { features this window has }
minSize, maxSize: point; { specify min and max allowable sizes during a "Grow window" }
vScrollTopOffset, vScrollBottomOffset, hScrollLeftOffset, hScrollRightOffset: integer;
{ amount of space left at ends of scroll bars }
hLinesPerPage, vLinesPerPage: integer; { clicking in the "page" area of a }
{ scroll bar is equivalent to clicking on an arrow this many times }
hPixelsPerLine, vPixelsPerLine: integer;
hScroll, vScroll: ControlHandle; { the horizontal and vertical scroll bars }
decorations: xWindowDecoration; { the "decorations" that have been installed in }
{ this window }
{ METHODS YOU ARE LIKELY TO OVERRIDE }
procedure openInRect (title: string;
left, top, right, bottom: integer);
{ Open a window, with (top,left) as upper left corner and (bottom,right) }
{ as lower right corner of inside of window (excluding title bar). }
{ If the rectangle specified by top, left, right and bottom are empty (for }
{ example, is they are all empty), then the window will fill the screen. }
{ This default method simply calls SetDefaults, then calls doBasicOpen. }
{ You can define a descendent class of xWindow by redefining SetDefaults }
{ and/or openInRect, as described in the comments at the start of the UNIT. }
procedure open (title: string);
{ Opens a window. Its width will be 3/4 of the screen width; its height 3/4 }
{ of the screen height, but not more than 2/3 of the width. Each successive }
{ window will be offset from the previous one. This method just calculates }
{ the window rect, then calls openInRect, so in a descendent class, you only }
{ need to redefine openInRect. }
procedure SetDefaults;
{ This procedure is meant to be called in OpenInRect before the window is }
{ actually opened, to set up parameters that will be used in opening the }
{ window. The default method calls SetFeatures, SetScrollOffsets, }
{ SetMinMaxSize, and SetLinesPerPage. If you want to change any of the }
{ defaults, or if you want to initialize any other instance variables, in a }
{ subclass of xWindows, you should override this method; call INHERITED }
{ SetDefaults, then make any changes or additions. This could be used, for }
{ example, if you don't want a horizontal scroll bar in your window, or if you }
{ want to set a maximum window size. }
{ SHOULD NOT BE CALLED ONCE THE WINDOW IS OPENED. xWindows does }
{ not support changing features on an open window. }
procedure doRedraw (badRect: Rect);
{ This is called when the contents of the window need to be redrawn, for }
{ example, when part of the window has been covered by a window which is }
{ then moved out of the way. The parameter badRect is a rectangle that }
{ includes the part of the window that needs to be redrawn. In most cases }
{ you can ignore this and draw the whole window, but in some case you might }
{ want to avoid unnecessary drawing. The default method draws any }
{ xWindowDecorations that have been installed in the window. }
{ DoRedraw is also called during scrolling, unless you override the methods }
{ doHScroll and doVScroll. If you have scroll bars, you will need to call }
{ GetHMax, GetVMax, GetHVal and GetVVal to determine which part of the }
{total data needs to be redrawn. }
procedure doKey (ch: char;
modifiers: longint);
{ Called when the user types a character and this window is the front }
{ window. The default method sends the keystroke to an xWindowDecoration. }
{ if appropriate. The parameter Modifiers is a copy of the modifiers field }
{ of the event record, which can be used to determine whether the user was }
{ holding down the option or shift key when the key was pressed. }
procedure doContentClick (localPt: point;
modifiers: longint);
{ Called when the user clicks in the content area of the window. This is NOT }
{ called when the user clicks in a scroll bar, grow box, etc.--such events are }
{ handled elsewhere. The parameter Modifiers is a copy of the modifiers field }
{ of the event record which can be used to determine whether the user was }
{ pressing the command, shift, or option key when the mouse down occure. }
{ The default method sends the click to an xWindowDecoration if appropriate. }
procedure doClose;
{ Called when the window is being closed because the user clicks in the }
{ close box of the window. You might also want to call it in response to a }
{ menu selection. The default method disposes of any xWindowDecorations }
{ and of the horizontal and vertical scroll bars, then closes the window. It does }
{ not dispose of the storage for the xWindow. You can use DISPOSE to do so, }
{ or you can open a new window without using NEW on the variable again. }
{ You might want to override this, for example, to dispose of the data that }
{ specifies the contents of the window. (Note however that the Mac toolbox }
{ procedure CloseWindow takes care of disposing of controls, such as }
{ buttons or check boxes. }
procedure doHScroll (dh: integer);
procedure doVScroll (dv: integer);
{ These are called when the user clicks in a scroll bar; they are called }
{ repeatedly as long as the user holds down the mouse button. The parameters }
{ dh and dv specify the change the user has made in the value of the scroll }
{ bar. The window contents must be drawn in response. By default, the old }
{ contents are erased and doRedraw is called. If you are satisified with this, }
{ you don't have to redefine these. However, the jerky visual appearance caused }
{ by erasing the whole window is not attractive. }
procedure AdjustToNewSize;
{ This is called when the window is resized (because of a doGrow or doZoom }
{ operation. The default method resizes and repositions the scroll bars and any }
{ xWindowDecoration. If you have added other stuff, you might need to adjust it. }
{ You will probably also need to set values associated with the scroll bars, }
{ such as HMax, VMax, HVal, VVal, LinesPerPage. Call INHERITED AdjustToNewSize }
{ to move the scroll bar and decorations. }
procedure doActivate (active: boolean);
{ This is called when the window is activated or deactivated. the default }
{ method hides the scroll bars on deactivation and shows them on reactivation. }
{ It also activates and deactivates xWindowDecorations. }
procedure idle;
{ This will ordinarily be called periodically while this is the front window. }
{ It can be called when there is no other event to be processed. In some }
{ applications, you might want to call it even when this is not the front }
{ window. A typically application is to call the ToolBox routine TEIdle when }
{ to blink the cursor in an active text edit. The default routine sends idle }
{ messages to any xWindowDecorations that have been installed. }
{ METHODS FOR SETTING AND READING VALUES }
procedure SetHMax (theMax: integer);
procedure SetVMax (theMax: integer);
procedure SetHVal (theVal: integer);
procedure SetVVal (theVal: integer);
function GetHMax: integer;
function GetVMax: integer;
function GetHVal: integer;
function GetVVal: integer;
procedure SetLinesPerPage (hPage, vPage: integer);
{ The values of the horizontal and vertical scroll bars go from zero to a }
{ user-specified maximum. Methods are provided to set and read both the }
{ values and the maximums. When the user clicks in the arrow of a scroll }
{ bar, the value changes by ±1. When the user clicks in the gray area of }
{ the bar, it should change by an amount representing, more or less, a page }
{ of data. SetLinesPerPage determines how many units the value should change }
{ by when the user clicks in the gray area. The method SetDefaults sets the }
{ page sizes to 1, so that clicking in the gray area will have the same effect }
{ as clicking on an arrow. Note that page sizes will generally have to be }
{ changed when the window changes size. }
procedure setTitle (str: string);
function getTitle: str255;
{ These methods set and read the title displayed in the window's title bar. }
procedure SetUserRef (theRef: longint);
function GetUserRef: longint;
{ These methods set and read a reference number associated with the }
{ window. xWindow makes no use of this number; it is provided for the }
{ user, for example to store a handle to data displayed in the window. }
{ UTILITY METHODS }
procedure hide;
procedure show;
procedure move (left, top: integer);
procedure setWindowSize (width, height: integer);
{ These four methods allow you to directly hide the window, show it, move it }
{ and set its size. Procedure move moves the widow without changing its }
{ size so that its upper left corner at the point (left,top). Procedure }
{ setWindowSize adjusts the lower right corner to acheive the specified }
{ width and height, and then calls AdjustToNewSize. }
{ METHODS FOR REWRITTING open }
procedure SetFeatures (theFeatures: windowFeatureSet);
{ Change the feature list. DO NOT CALL ONCE THE WINDOW IS OPENED. }
procedure SetScrollOffsets (vTop, vBottom, hLeft, hRight: integer);
{ Change the space left at the ends of the scroll bars. By default, no extra }
{ space is left. For example, you could use this if you want the vertical }
{ scroll to start 50 points from the top of the window. You should probably }
{ adjust the maximum and minimum sizes with SetMaxMinSize to make sure }
{ the window contains enouge space for the scroll bars. You should not call }
{ this procedure while the window is open (but if you really want to, you }
{ call it and then use the Mac toolbox routine InvalRect to force a window }
{ redraw.) }
procedure SetMinDragWidth (minWidth: integer);
procedure SetMaxDragWidth (maxWidth: integer);
procedure SetMinDragHeight (minHeight: integer);
procedure SetMaxDragHeight (maxHeight: integer);
{ These determine the maximum and minimum sizes of the window when the user }
{ drags the window's GrowBox to resize the window. By default, the minimums are }
{ very small and the maximums are essentially infinite. You should make sure that }
{ minimum size is sufficient to contain any "decorations you add to the window. }
{ Also, make sure the original window fits in the specified ranges. }
procedure doBasicOpen (title: string;
left, top, right, bottom: integer);
{ Opens the window, using (left,top) and (bottom,right) as the upper left }
{ and lower right corners of the content rectangle of the window (excluding }
{ the title bar and border). DO NOT CALL UNTIL VALUES HAVE BEEN SET }
{ WITH PRECEDING PROCEDURES. }
{ METHODS YOU WILL PROBABLY NEVER CHANGE OR USE DIRECTLY }
procedure doEvent (event: eventRecord);
{ Called to handle an event directed to this window; directs the event }
{ to one of the following methods or to doActivate or to doKey. }
procedure doUpdate;
{ Handles an update event for the window; calls doRedraw. }
procedure doClick (globalPt: point;
modifiers: longint);
{ Handles a click anywhere in the window by calling appropriate method }
procedure doGrow (startPt: point);
{ Handles a user click in the GrowBox }
procedure doDrag (startPt: point);
{ Handles a user click in the title bar (exclusive of goAwayBox or ZoomBox }
procedure doZoom (startPt: point;
partNum: integer);
{ Handles a user click in the ZoomBox }
procedure adjustCursor (localPt: point);
{ if the cursor is over an xWindowDecoration, this sets the cursor to }
{ cursor for that decoration; otherwise it sets the cursor to the standard }
{ arrow }
end; { definition of xWindows }
xWindowDecoration = object
{ abstract class defining the common protocol for objects, such as buttons, }
{ pictures, and input boxes, that can be added to xWidows. }
{ INSTANCE VARIABLES }
itsWindow: xWindow; { the window into which the decoration has been installed }
nextDecoration: xWindowDecoration; { link in list of decorations for that window }
drawRect: Rect; { rectangle completely containing the item }
clickRect: Rect; { a rectangle containing the part of the decoration that can respond }
{ to clicks (if any); should be contained in drawRect; by default is }
{ equal to drawRect }
left, top, height, width: integer; { values determining position and size of object }
{ (See procedure Install for a description ) }
visible: boolean; { set to false if item is hidden }
wantsKey, wantsClick, wantsCR: boolean; { determines whether events are sent }
{ by xWindow procedures to this decoration; generally, only the }
{ first (most recent) item in the decoration list that wants the event }
{ receives it. }
itsCursor: cursor; { the cursor to be displayed over this item's clickRect, if it is }
{ active and visible }
grayedOut: boolean; { set to true by some descendent class when the item is deactivated }
{ METHODS FOR INITIALIZING THE DECORATION }
procedure init;
{ inialize most of the instance variables; should be called before you do }
{ anything else with the object. }
procedure install (win: xWindow;
theLeft, theTop, theWidth, theHeight: integer);
{ Add an init'ed object to the specified xWindow. The values of theLeft and }
{ theTop determine the top left cornor of the drawRect of the item. If both }
{ are >= 0, then they simply give the coordinated of the that point. If theLeft }
{ is < 0, then the left side of the drawRect will be given by subtracting }
{ abs(theLeft) from the right side of the window. For example, if topLeft is }
{ -50, then the top left cornor of the item will be 50 pixels in from the right }
{ edge of the window; this relationship will be reestablished when the window }
{ is resized by moving the item if necessary. }
{ Similarly, if theTop is < 0, then it gives the position of the top of the }
{ decoration as an offset from the bottom edge of the window, so that the top }
{ of the decoration will remain at a fixed height above the bottom of the window, }
{ given by abs(theTop). }
{ Once the top, left cornor of the decoration is deterimined, then theWidth }
{ theHeight are used to determine the width and height of the item. If they are }
{ both > 0, then they simply specify the actual height and width. If theHeight is }
{ <= 0, then its value is used as follows: the right edge of the decoration's drawRect }
{ will be positioned abs(theHeight) pixels in from the right edge of the window. }
{ Similarly, if theWidth is <= 0, then the bottom edge of the decoration will be }
{ abs(theWidth) pixels above the bottom edge of the window. }
{ Note that theLeft, theTop, theWidth and theHeight are stored in the instance }
{ variables left, top, width and height and are used to recompute the position and }
{ size of the decoration when the size of the window changes. }
{ All this is not as confusing as it may sound. Here are some examples: }
{ Install(xWin,10,10,-10,30): the decoration is 30 units high, with top left }
{ cornor at (10,10). It stretches all across the top of the window. }
{ Install(xWin,-60,20,40,40): the decoration occupies a 40 by 40 square }
{ that hangs in the top right cornor of the window. }
{ METHODS FOR MANIPULATING THE DECORATION }
procedure move (newLeft, newTop: integer);
{ move the decoration; newLeft and newTop have the same meaning as theLeft }
{ and theTop in procedure Install. }
procedure setSize (newWidth, newHeight: integer);
{ change the size of the decoration; newWidth and newHeight have the same }
{ meaning as theWidth and theHeight in procedure Install }
procedure remove;
{ removes the item from its window, without destroying the data structures; }
{ it could then potentially be installed in another window }
procedure kill;
{ remove the item from its window and dispose of all storage (including calling }
{ Dispose on the object itself }
procedure hide;
{ make the decoration invisible; it can be made visible again with Show }
procedure show;
{ makes a hidden decoration visible again }
procedure useCursor (c: cursor);
{ specify that this cursor should be shown when the cursor position is over this }
{ decoration's clickRect (and it is visible and not grayed out); by default, a }
{ standard arrow cursor is used }
procedure forceRedraw;
{ forces an update event for the drawRect of this decoration }
{ METHODS CALLED IN RESPONSE TO VARIOUS EVENTS }
procedure adjustSize;
{called by install, setSize, move and xWindow.AdjustToNewSize to do the }
{ calculation of the position and size of the decoration, as described in }
{ procedure install; if you override this method, you can make any other }
{ adjustments necessary when your decoration is moved or resized }
procedure doKey (ch: char;
modifiers: longint);
{ handle a keystroke, other than CR or ENTER; this is sent by procedure }
{ xWindow.doKey to the first decoration in the window for which the instance }
{ variable wantsKey is true (if any); "modifiers" is the modifiers field of }
{ the event record for the keyDown event. }
procedure doCR (ch: char);
{ respond to user pressing either CR or ENTER; this is sent by procedure }
{ xWindow.doKey to the first decoration in the window for which the instance }
{ variable wantsKey is true (if any) }
procedure doClick (localPt: point;
modifiers: longint);
{ respond to the user clicking the mouse; this is sent by procedure }
{ xWindow.doContentClick to the first decoration it finds whose clickRect }
{ contains the given point }
procedure doDraw;
{ redraws the decoration; called by xWindow.doRedraw }
procedure doActivate (active: boolean);
{ respond to an activate event for the window }
procedure Idle;
{ this is sent once each time through the event loop to any active, visible }
{ decoration in the front window; sent by xWindow.idle. }
end; { definition of xWindowDecoration }
var
windowRect: Rect; { used in opening widnows in procedure xWindows.openInRect. }
procedure InitXWindows;
{ This procedure is called in StandardMain; all it does is initialize the list of open }
{ xWindows to NIL }
function Window2xWindow (win: WindowPtr;
var xWin: xWindow): boolean;
{ looks up a Macintosh window in the list of open xWindows; returns TRUE if it is }
{ found, FALSE if not. If it is found, xWin is set to be the xWindow corresponding to }
{ the Macintosh window. }
procedure TellUser (message: string);
{ a utility procedure that simply displays an alert box containing the message, with an}
{ OK button for the user to click; requires the presense of the alert resource #129 in }
{ resources for the program }
implementation
var
FirstWin: xWindow;
procedure TellUser (message: string);
var
bttn: integer;
begin
ParamText(message, '', '', '');
SetCursor(arrow);
bttn := NoteAlert(129, nil);
if bttn = -1 then
Sysbeep(5);
end;
procedure InitXWindows;
begin
FirstWin := nil;
end;
function Window2xWindow (win: WindowPtr;
var xWin: xWindow): boolean;
begin
xWin := FirstWin;
while (xWin <> nil) & (xWin.theWindow <> win) do
xWin := xWin.nextXWindow;
Window2xWindow := xWin <> nil;
end;
procedure GetWindowRect (var left, top, right, bottom: integer);
{ provides a succession of rectangles for opening windows, each offset over and down }
{ from the last. }
var
r: Rect; { a full screen }
w, h: integer; { width and height of window rect }
begin
r := screenbits.bounds;
r.top := r.top + 38;
w := (3 * (r.right - r.left) div 4);
h := (3 * (r.bottom - r.top) div 4);
if w > 1000 then
w := 1000;
if h > 2 * w div 3 then
h := 2 * w div 3;
{ we have to be carefull to initialize windowRect if it is not of the right size or not on the }
{ screen, as is almost certainly the case when the program starts. }
if not PtInRect(windowRect.topLeft, R) | (w <> windowRect.right - windowRect.left) | (h <> windowRect.bottom - windowRect.top) then begin
left := r.left + 4;
top := r.top + 4;
bottom := top + h;
right := left + w;
SetRect(windowRect, left, top, right, bottom);
end
else begin
OffsetRect(WindowRect, 15, 15);
if windowRect.Right > R.right - 2 then begin
windowRect.left := R.left + 4;
windowRect.right := windowRect.left + w;
if windowRect.bottom > R.bottom - 2 then begin
windowRect.top := R.top + 11;
windowRect.bottom := windowRect.top + h;
end;
end
else if windowRect.bottom > R.bottom - 2 then begin
windowRect.top := R.top + 4;
windowRect.bottom := windowRect.top + h;
end;
left := windowRect.left;
right := windowRect.right;
top := windowRect.top;
bottom := windowRect.bottom;
end;
end;
procedure xWindow.open (title: string);
var
left, top, right, bottom: integer;
begin
GetWindowRect(left, top, right, bottom);
openInRect(title, left, top, right, bottom);
end;
procedure xWindow.openInRect (title: string;
left, top, right, bottom: integer);
begin
SetDefaults;
doBasicOpen(title, left, top, right, bottom);
end;
procedure xWindow.doRedraw (badRect: Rect);
var
d: xWindowDecoration;
junk: rect;
begin
d := decorations;
while d <> nil do begin
if SectRect(d.drawRect, badRect, junk) & d.visible then
d.doDraw;
d := d.nextDecoration;
end;
end;
procedure xWindow.doContentClick (localPt: point;
modifiers: longint);
var
d: xWindowDecoration;
begin
d := decorations;
while d <> nil do
if PtInRect(localPt, d.clickRect) & d.wantsClick & d.visible then begin
d.doClick(localPt, modifiers);
EXIT(doContentClick);
end
else
d := d.nextDecoration;
end;
procedure xWindow.doKey (ch: char;
modifiers: longint);
var
d: xWindowDecoration;
begin
d := decorations;
if (ch = chr(13)) | (ch = chr(3)) then begin
while d <> nil do
if d.wantsCR & d.visible then begin
d.doCR(ch);
EXIT(doKey);
end
else
d := d.nextDecoration;
end
else
while d <> nil do
if d.wantsKey & d.visible then begin
d.doKey(ch, modifiers);
EXIT(doKey);
end
else
d := d.nextDecoration;
end;
procedure xWindow.Idle;
var
d: xWindowDecoration;
begin
d := decorations;
while d <> nil do begin
if d.visible and not d.grayedOut then
d.idle;
d := d.nextDecoration;
end;
end;
procedure xWindow.SetDefaults;
var
min, max: point;
begin
SetFeatures([hasGoAway, hasHScroll, hasVScroll, hasZoom, hasGrow]);
SetScrollOffsets(0, 0, 0, 0);
SetLinesPerPage(1, 1);
SetMinDragWidth(50);
SetMinDragHeight(50);
SetMaxDragWidth(maxint);
SetMaxDragHeight(maxint);
hpixelsPerLine := 1;
vpixelsPerLine := 1;
end;
procedure xWindow.SetFeatures (theFeatures: windowFeatureSet);
begin
features := theFeatures;
end;
procedure xWindow.SetScrollOffsets (vTop, vBottom, hLeft, hRight: integer);
begin
vScrollTopOffset := vTop;
vScrollBottomOffset := vBottom;
hScrollLeftOffset := hLeft;
hScrollRightOffset := hRight;
end;
procedure xWindow.SetLinesPerPage (hPage, vPage: integer);
begin
hLinesPerPage := hPage;
vLinesPerPage := vPage;
end;
procedure xWindow.SetMinDragWidth (minWidth: integer);
begin
minSize.h := minWidth;
end;
procedure xWindow.SetMaxDragWidth (maxWidth: integer);
begin
maxSize.h := maxWidth;
end;
procedure xWindow.SetMinDragHeight (minHeight: integer);
begin
minSize.v := minHeight;
end;
procedure xWindow.SetMaxDragHeight (maxHeight: integer);
begin
maxSize.v := maxHeight;
end;
procedure xWindow.doBasicOpen (title: string;
left, top, right, bottom: integer);
var
R, openRect: Rect;
windowProc: integer;
goAway: boolean;
win: WindowPtr;
begin
if minSize.h <= 10 then
minSize.h := 30;
if maxSize.h <= minSize.h then
maxSize.h := minSize.h;
if minSize.v <= 10 then
minSize.v := 30;
if maxSize.v <= minSize.v then
maxSize.v := minSize.v;
if hScrollLeftOffset < 0 then
hScrollLeftOffset := 0;
if hScrollRightOffset < 0 then
hScrollRightOffset := 0;
if vScrollTopOffset < 0 then
vScrollTopOffset := 0;
if vScrollBottomOffset < 0 then
vScrollBottomOffset := 0;
SetRect(openRect, left, top, right, bottom);
if EmptyRect(openRect) then begin
openRect := screenBits.bounds;
InsetRect(openRect, 5, 5);
openRect.top := openRect.top + 38;
end;
if openRect.bottom < openRect.top + 30 then
openRect.bottom := openRect.top + 30;
if openRect.right < openRect.left + 30 then
openRect.right := openRect.left + 30;
goAway := hasGoAway in features;
if hasGrow in features then
windowProc := documentProc
else
windowProc := noGrowDocProc;
if hasZoom in features then
windowProc := windowProc + 8;
if DAStyle in features then
win := NewWindow(nil, openRect, title, true, rDocProc, pointer(-1), goAway, longint(self))
else
win := NewWindow(nil, openRect, title, true, windowProc, pointer(-1), goAway, longint(self));
theWindow := win;
decorations := nil;
if hasVScroll in features then begin
R := theWindow^.portRect;
R.right := R.right + 1;
if (hasGrow in features) then
R.bottom := R.bottom - 14
else
R.bottom := R.bottom + 1;
R.left := R.right - 16;
R.top := R.top + vScrollTopOffset - 1;
R.bottom := R.bottom - vScrollBottomOffset;
vScroll := NewControl(win, R, '', false, 0, 0, 0, scrollBarProc, longint(self));
end;
if hasHScroll in features then begin
R := theWindow^.portRect;
if (hasGrow in features) | (hasVScroll in features) then
R.right := R.right - 14
else
R.right := R.right + 1;
R.bottom := R.bottom + 1;
R.top := R.bottom - 16;
R.left := R.left + hScrollLeftOffset - 1;
R.right := R.right - hScrollRightOffset;
hScroll := NewControl(win, R, '', false, 0, 0, 0, scrollBarProc, longint(self));
end;
nextXWindow := FirstWin;
FirstWin := self
end;
procedure xWindow.doClose;
var
d, nextD: xWindowDecoration;
runner: xWindow;
begin
d := decorations;
while d <> nil do begin
nextD := d.nextDecoration;
d.kill;
d := nextD;
end;
if self = FirstWin then { remove self from list of xWindows }
FirstWin := FirstWin.nextXWindow
else begin
runner := FirstWin;
while (runner.nextXWindow <> nil) & (runner.nextXwindow <> self) do
runner := runner.nextXWindow;
if runner.nextXWindow <> nil then
runner.nextXWindow := runner.nextXWindow.nextXWindow;
end;
CloseWindow(theWindow);
end;
procedure xWindow.hide;
begin
HideWindow(theWindow);
end;
procedure xWindow.show;
begin
ShowWindow(theWindow);
end;
procedure xWindow.move (left, top: integer);
begin
MoveWindow(theWindow, left, top, false);
end;
procedure xWindow.setWindowSize (width, height: integer);
begin
SizeWindow(theWindow, width, height, false);
AdjustToNewSize;
end;
procedure xWindow.SetUserRef (theRef: longint);
begin
userRef := theRef;
end;
function xWindow.GetUserRef: longint;
begin
GetUserRef := userRef;
end;
procedure xWindow.AdjustToNewSize;
var
newHeight, newWidth: integer;
savePort: GrafPtr;
d: xWindowDecoration;
begin
newWidth := theWindow^.portRect.right - theWindow^.portRect.left;
newHeight := theWindow^.portRect.bottom - theWindow^.portRect.top;
if hasHScroll in features then
HideControl(hScroll);
if hasVScroll in features then
HideControl(vScroll);
SizeWindow(theWindow, newWidth, newHeight, false);
GetPort(savePort);
SetPort(theWindow);
if hasHScroll in features then begin
MoveControl(hScroll, theWindow^.portRect.left - 1 + hScrollLeftOffset, theWindow^.portRect.bottom - 15);
if (hasVscroll in features) | (hasGrow in features) then
newWidth := newWidth - 13
else
newWidth := newWidth + 2;
SizeControl(hScroll, newWidth - hScrollLeftOffset - hScrollRightOffset, 16);
ShowControl(hScroll);
end;
if hasVScroll in features then begin
MoveControl(vScroll, theWindow^.portRect.right - 15, theWindow^.portRect.top - 1 + vScrollTopOffset);
if hasGrow in features then
newHeight := newHeight - 13
else
newHeight := newHeight + 2;
SizeControl(vScroll, 16, newHeight - vScrollTopOffset - vScrollBottomOffset);
ShowControl(vScroll);
end;
d := decorations;
while d <> nil do begin
d.adjustSize;
d := d.nextDecoration;
end;
InvalRect(theWindow^.portRect);
SetPort(savePort);
end;
procedure xWindow.doEvent (event: eventRecord);
begin
case event.what of
keyDown, autoKey:
doKey(chr(BitAnd(event.message, $FF)), event.modifiers);
mouseDown:
doClick(event.where, event.modifiers);
updateEvt:
doUpdate;
activateEvt:
doActivate(BitAnd(event.modifiers, activeFlag) <> 0);
otherwise
end;
end;
procedure xWindow.setTitle (str: string);
begin
SetWTitle(theWindow, str);
end;
function xWindow.getTitle: str255;
var
str: str255;
begin
GetWTitle(theWindow, str);
getTitle := str;
end;
procedure xWindow.SetHMax (theMax: integer);
begin
if hasHScroll in features then
SetCtlMax(hScroll, theMax);
end;
procedure xWindow.SetVMax (theMax: integer);
begin
if hasVScroll in features then
SetCtlMax(vScroll, theMax);
end;
procedure xWindow.SetHVal (theVal: integer);
begin
if hasHScroll in features then
SetCtlValue(hScroll, theVal);
end;
procedure xWindow.SetVVal (theVal: integer);
begin
if hasVScroll in features then
SetCtlValue(vScroll, theVal);
end;
function xWindow.GetHMax: integer;
begin
if hasHScroll in features then
GetHMax := GetCtlMax(hScroll)
else
GetHMax := 0;
end;
function xWindow.GetVMax: integer;
begin
if hasVScroll in features then
GetVMax := GetCtlMax(vScroll)
else
GetVMax := 0;
end;
function xWindow.GetHVal: integer;
var
val: integer;
begin
if hasHScroll in features then
val := GetCtlValue(hScroll)
else
val := 0;
GetHVal := val;
end;
function xWindow.GetVVal: integer;
var
val: integer;
begin
if hasVScroll in features then
val := GetCtlValue(vScroll)
else
val := 0;
GetVVal := val;
end;
procedure xWindow.doHScroll (dh: integer);
var
savePort: GrafPtr;
R: rect;
begin
GetPort(savePort);
SetPort(theWindow);
R := theWindow^.portRect;
if hasVScroll in features then
R.right := R.right - 15;
if hasHScroll in features then
r.bottom := R.bottom - 15;
EraseRect(R);
doReDraw(R);
SetPort(savePort);
end;
procedure xWindow.doVScroll (dv: integer);
var
savePort: GrafPtr;
R: rect;
begin
GetPort(savePort);
SetPort(theWindow);
R := theWindow^.portRect;
if hasVScroll in features then
R.right := R.right - 15;
if hasHScroll in features then
r.bottom := R.bottom - 15;
EraseRect(R);
doReDraw(R);
SetPort(savePort);
end;
procedure continuousScroll (ctl: ControlHandle;
partCode: integer);
var
win: xWindow;
lines: integer;
horizontal: boolean;
val: integer;
max: integer;
begin
val := getCtlValue(ctl);
max := getCtlMax(ctl);
win := xWindow(ctl^^.ContrlRfCon);
horizontal := (hasHScroll in win.features) & (ctl = win.hScroll);
case partCode of
inDownButton:
if horizontal then
lines := win.hpixelsperline
else
lines := win.vpixelsPerLine;
inUpButton:
if horizontal then
lines := -win.hpixelsperline
else
lines := -win.vpixelsPerLine;
inPageDown:
if horizontal then
lines := win.hLinesPerPage
else
lines := win.vLinesPerPage;
inPageUp:
if horizontal then
lines := -win.hLinesPerPage
else
lines := -win.vLinesPerPage;
otherwise
EXIT(ContinuousScroll);
end;
if val + lines < 0 then
lines := -val
else if val + lines > max then
lines := max - val;
if lines <> 0 then begin
SetCtlValue(ctl, val + lines);
if horizontal then
win.doHScroll(lines)
else
win.doVScroll(lines)
end;
end;
procedure xWindow.doClick (globalPt: point;
modifiers: longint);
var
partNum: integer;
savePort: grafPtr;
part: integer;
theControl: controlHandle;
oldVal: integer;
begin
if theWindow <> FrontWindow then
SelectWindow(theWindow)
else begin
partNum := FindWindow(globalPt, theWindow);
case partnum of
inContent: begin
GetPort(savePort);
SetPort(theWindow);
GlobalToLocal(globalPt);
if ((not (hasHScroll in features) | (not PtInRect(globalPt, hScroll^^.contrlRect))) & (not (hasVScroll in features) | (not PtInRect(globalPt, vScroll^^.contrlRect)))) & (globalPt.h < theWindow^.portRect.right) & (globalPt.v < theWindow^.portRect.bottom) then
doContentClick(globalPt, modifiers)
else begin
part := FindControl(globalPt, theWindow, theControl);
if (theControl <> hScroll) & (theControl <> vScroll) then begin
end
else if part in [inUpButton, inDownButton, inPageUp, inPageDown] then
part := TrackControl(theControl, globalPt, @continuousScroll)
else if part = inThumb then begin
oldVal := GetCtlValue(theControl);
part := TrackControl(theControl, globalPt, nil);
if (part = inThumb) & (oldVal <> GetCtlValue(theControl)) then
if theControl = HScroll then
doHScroll(GetCtlValue(theControl) - oldVal)
else
doVScroll(GetCtlValue(theControl) - oldVal)
end;
end;
SetPort(savePort);
end;
inDrag:
doDrag(globalPt);
inGrow:
DoGrow(globalPt);
inGoAway:
if TrackGoAway(theWindow, globalPt) then
doClose;
inZoomIn, inZoomOut:
doZoom(globalPt, partNum);
end;
end;
end;
procedure xWindow.doGrow (startPt: point);
var
R: rect;
newSize: longint;
height, width: integer;
savePort: GrafPtr;
begin
SetRect(R, minSize.h, minSize.v, maxSize.h, maxSize.v);
newSize := GrowWindow(theWindow, startPt, R);
if newSize <> 0 then begin
width := LoWord(newSize);
height := HiWord(newSize);
GetPort(savePort);
SetPort(theWindow);
eraseRect(theWindow^.portRect);
SizeWindow(theWindow, Width, Height, false);
AdjustToNewSize;
SetPort(savePort);
end;
end;
procedure xWindow.doDrag (startPt: point);
var
R: Rect;
begin
R := screenBits.bounds;
R.top := 20;
InsetRect(R, 4, 4);
DragWindow(theWindow, startPt, R);
end;
procedure xWindow.doZoom (startPt: point;
partNum: integer);
var
savePort: GrafPtr;
begin
if not TrackBox(theWindow, startPt, partNum) then
EXIT(doZoom);
getPort(savePort);
setPort(theWindow);
eraseRect(theWindow^.portRect);
ZoomWindow(theWindow, partNum, false);
AdjustToNewSize;
SetPort(savePort);
end;
procedure xWindow.doUpdate;
var
savePort: GrafPtr;
R: rect;
oldPen: penState;
begin
GetPort(savePort);
SetPort(theWindow);
BeginUpdate(theWindow);
EraseRect(theWindow^.portRect);
if hasGrow in features then begin
GetPenState(oldPen);
PenSize(1, 1);
PenPat(black);
DrawGrowIcon(theWindow);
R := theWindow^.portRect;
PenMode(notPatCopy);
if not (hasHScroll in features) then begin
MoveTo(R.left, R.bottom - 15);
LineTo(R.right - 16, R.bottom - 15);
end
else if hScrollLeftOffset > 0 then begin
MoveTo(R.left, R.bottom - 15);
LineTo(hScrollLeftOffset - 1, R.bottom - 15);
PenMode(PatCopy);
Line(0, 14);
PenMode(notPatCopy);
end;
if not (hasVScroll in features) then begin
MoveTo(R.Right - 15, R.top);
LineTo(R.right - 15, R.bottom - 16);
end
else if vScrollTopOffset > 0 then begin
MoveTo(R.right - 15, R.top);
LineTo(R.right - 15, vScrollTopOffset - 1);
PenMode(PatCopy);
Line(14, 0);
end;
PenMode(PatCopy);
SetPenState(oldPen);
end;
UpdtControl(theWindow, theWindow^.visRgn);
doReDraw(theWindow^.visRgn^^.rgnBBox);
EndUpdate(theWindow);
SetPort(savePort);
end;
procedure xWindow.doActivate (active: boolean);
var
savePort: grafPtr;
R: rect;
d: xWindowDecoration;
begin
if hasGrow in features then begin { force redraw of grow icon }
GetPort(savePort);
SetPort(theWindow);
R := theWindow^.portRect;
R.top := R.bottom - 13;
R.left := R.right - 13;
InvalRect(R);
SetPort(savePort);
end;
if active then begin
if hasVScroll in features then
ShowControl(vScroll);
if hasHscroll in features then
ShowControl(hScroll);
end
else begin
if hasVScroll in features then
HideControl(vScroll);
if hasHscroll in features then
HideControl(hScroll);
end;
d := decorations;
while d <> nil do begin
d.doActivate(active);
d := d.nextDecoration;
end;
end;
procedure xWindow.adjustCursor (localPt: point);
var
d: xWindowDecoration;
begin
d := decorations;
while d <> nil do
if PtInRect(localPt, d.clickRect) & not d.grayedOut & d.visible then begin
SetCursor(d.itsCursor);
EXIT(adjustCursor);
end
else
d := d.nextDecoration;
setCursor(arrow);
end;
procedure xWindowDecoration.init;
begin
itsWindow := nil;
nextDecoration := nil;
visible := true;
wantsKey := false;
wantsClick := false;
wantsCR := false;
itsCursor := arrow;
grayedOut := false;
end;
procedure xWindowDecoration.install (Win: xWindow;
theLeft, theTop, theWidth, theHeight: integer);
var
savePort: GrafPtr;
d: xWindowDecoration;
begin
left := theLeft;
top := theTop;
width := theWidth;
height := theHeight;
itsWindow := win;
nextDecoration := nil;
if win.decorations = nil then
win.decorations := self
else begin
d := win.decorations;
while d.nextDecoration <> nil do
d := d.nextDecoration;
d.nextDecoration := self;
end;
adjustSize;
if (win.theWindow <> nil) & visible then begin
GetPort(savePort);
SetPort(win.theWindow);
InvalRect(drawRect);
SetPort(savePort);
end;
end;
procedure xWindowDecoration.remove;
var
savePort: GrafPtr;
d: xWindowDecoration;
found: boolean;
begin
if itsWindow <> nil then begin
d := itsWindow.decorations;
found := false;
if d = self then begin
itsWindow.decorations := itsWindow.decorations.nextDecoration;
found := true;
end
else begin
while (d <> nil) & (d.nextDecoration <> self) do
d := d.nextDecoration;
if d <> nil then begin
d.nextDecoration := d.nextDecoration.nextDecoration;
found := true;
end;
end;
if found & (itsWindow.theWindow <> nil) then begin
GetPort(savePort);
SetPort(itsWindow.theWindow);
InvalRect(drawRect);
SetPort(savePort);
end;
itsWindow := nil;
nextDecoration := nil;
end;
end;
procedure xWindowDecoration.move (newLeft, newTop: integer);
var
savePort: GrafPtr;
begin
if (newLeft <> left) | (newTop <> top) then begin
left := newLeft;
top := newTop;
GetPort(savePort);
if (itsWindow <> nil) & (itsWindow.theWindow <> nil) then begin
GetPort(savePort);
SetPort(itsWindow.theWindow);
InvalRect(drawRect);
SetPort(savePort);
adjustSize;
end;
end;
end;
procedure xWindowDecoration.setSize (newWidth, newHeight: integer);
var
savePort: GrafPtr;
begin
if (newHeight <> height) | (newWidth <> width) then begin
height := newHeight;
width := newWidth;
GetPort(savePort);
if (itsWindow <> nil) & (itsWindow.theWindow <> nil) then begin
GetPort(savePort);
SetPort(itsWindow.theWindow);
if visible then
InvalRect(drawRect);
adjustSize;
if visible then
InvalRect(drawRect);
SetPort(savePort);
end;
end;
end;
procedure xWindowDecoration.kill;
begin
remove;
dispose(self);
end;
procedure xWindowDecoration.hide;
var
savePort: GrafPtr;
begin
if visible then begin
visible := false;
if (itsWindow <> nil) & (itsWindow.theWindow <> nil) then begin
GetPort(savePort);
SetPort(itsWindow.theWindow);
InvalRect(drawRect);
SetPort(savePort);
end;
end;
end;
procedure xWindowDecoration.show;
var
savePort: GrafPtr;
begin
if not visible then begin
visible := true;
if (itsWindow <> nil) & (itsWindow.theWindow <> nil) then begin
GetPort(savePort);
SetPort(itsWindow.theWindow);
InvalRect(drawRect);
SetPort(savePort);
end;
end;
end;
procedure xWindowDecoration.useCursor (c: cursor);
begin
itsCursor := c;
end;
procedure xWindowDecoration.forceRedraw;
var
savePort: GrafPtr;
begin
if (itsWindow = nil) | (itsWindow.theWindow = nil) then
EXIT(forceRedraw);
GetPort(savePort);
SetPort(itsWindow.theWindow);
InvalRect(drawRect);
SetPort(savePort);
end;
procedure xWindowDecoration.adjustSize;
begin
if (itsWindow <> nil) & (itsWindow.theWindow <> nil) then begin
if left < 0 then
drawRect.left := itsWindow.theWindow^.portRect.right + left
else
drawRect.left := left;
if top < 0 then
drawRect.top := itsWindow.theWindow^.portRect.bottom + top
else
drawRect.top := top;
if height <= 0 then
drawRect.bottom := itsWindow.theWindow^.portRect.bottom + height
else
drawRect.bottom := drawRect.top + height;
if width <= 0 then
drawRect.right := itsWindow.theWindow^.portRect.right + width
else
drawRect.right := drawRect.left + width;
clickRect := drawRect;
end;
end;
procedure xWindowDecoration.doCR (ch: char);
begin
end;
procedure xWindowDecoration.doKey (ch: char;
modifiers: longint);
begin
end;
procedure xWindowDecoration.doClick (localPt: point;
modifiers: longint);
begin
end;
procedure xWindowDecoration.doDraw;
begin
end;
procedure xWindowDecoration.doActivate (active: boolean);
begin
end;
procedure xWindowDecoration.Idle;
begin
end;
end.